home *** CD-ROM | disk | FTP | other *** search
- MODULE EditListClass;
-
- IMPORT
- e := Exec,
- I := Intuition,
- rc := RootClass,
- m := Mui,
- ms := MuiSimple,
- sc := MUIGroup,
- u := Utility,
- y := SYSTEM;
-
- TYPE
-
- (*/// -------------------------- "RECORD ClassDesc" -------------------------- *)
- Class = UNTRACED POINTER TO ClassDesc;
- ClassDesc = RECORD( sc.ClassDesc );
- list : m.Object;
- string : m.Object;
- group : m.Object;
- menu : m.Object;
- setHook : u.HookPtr;
- getHook : u.HookPtr;
- END;
-
- (*\\\*)
-
- pSetString = STRUCT( msg : I.Msg ) END;
- pGetString = STRUCT( msg : I.Msg ) END;
-
- menu = ARRAY 5 OF e.STRPTR;
-
- CONST
- tagBase = u.user + (74*65536);
-
- aNewText *= tagBase+1;
- aRemoveText *= tagBase+2;
- aUpText *= tagBase+3;
- aDownText *= tagBase+4;
-
-
- mNew *= tagBase+5;
- mRemove *= tagBase+6;
- mUp *= tagBase+7;
- mDown *= tagBase+8;
- mSetString = tagBase+10;
- mGetString = tagBase+15;
-
- aSetStringHook *= tagBase+11;
- vSetStringHookString *= tagBase+12;
- aGetStringHook *= tagBase+13;
- vGetStringHookString *= tagBase+14;
-
- aNewMenuText *= tagBase+15;
- aRemoveMenuText *= tagBase+16;
- aUpMenuText *= tagBase+17;
- aDownMenuText *= tagBase+18;
- aHelpMenuText *= tagBase+19;
-
- VAR
- class -: I.IClassPtr;
-
- (*/// ---------------------- "PROCEDURE ClassDesc.Up()" ---------------------- *)
-
- PROCEDURE ( VAR c : ClassDesc ) Up( VAR msg : I.Msg ):e.APTR;
- VAR act : LONGINT;
- BEGIN
- ms.Get( c.list, m.aListActive, act );
- IF act # m.vListActiveOff THEN
- m.DoMethod( c.list, m.mListMove, m.vListMoveActive, m.vListMovePrevious );
- ms.Set( c.list, m.aListActive, m.vListActiveUp );
- END;
- RETURN NIL;
- END Up;
-
- (*\\\*)
- (*/// --------------------- "PROCEDURE ClassDesc.Down()" --------------------- *)
-
- PROCEDURE ( VAR c : ClassDesc ) Down( VAR msg : I.Msg ):e.APTR;
- VAR act : LONGINT;
- BEGIN
- ms.Get( c.list, m.aListActive, act );
- IF act # m.vListActiveOff THEN
- m.DoMethod( c.list, m.mListMove, m.vListMoveActive, m.vListMoveNext );
- ms.Set( c.list, m.aListActive, m.vListActiveDown );
- END;
- RETURN NIL;
- END Down;
-
- (*\\\*)
- (*/// ------------------ "PROCEDURE ClassDesc.SetString()" ------------------- *)
-
- PROCEDURE ( VAR c : ClassDesc ) SetString( VAR msg : pSetString ):e.APTR;
- VAR str : e.STRPTR;
- pos, cnt : LONGINT;
- ret : e.APTR;
- BEGIN
- ret := NIL;
- m.DoMethod( c.list, m.mKillNotify, m.aListActive );
- IF y.VAL( LONGINT, c.setHook ) = vSetStringHookString THEN
- ms.Get( c.string, m.aStringContents, str );
- IF (str # NIL) & (str[0]# 0X) THEN
- ms.Set( c.list, m.aListQuiet, e.true );
- ms.Get( c.list, m.aListActive, pos );
- ms.Get( c.list, m.aListEntries, cnt );
- IF pos # m.vListActiveOff THEN
- m.DoMethod( c.list, m.mListRemove, m.vListRemoveActive );
- IF (pos = 0) OR (pos = m.vListActiveOff) THEN
- m.DoMethod( c.list, m.mListInsertSingle, str, m.vListInsertTop );
- ELSIF (cnt-pos) = 1 THEN;
- m.DoMethod( c.list, m.mListInsertSingle, str, m.vListInsertBottom );
- ELSE
- m.DoMethod( c.list, m.mListInsertSingle, str, pos );
- END;
- ms.Set( c.list, m.aListActive, pos );
- END;
- ms.Set( c.list, m.aListQuiet, e.false );
- END;
- ELSIF c.setHook # NIL THEN
- ret := u.CallHookPkt( c.setHook, c.list, c.string );
- END;
- m.DoMethod( c.list, m.mNotify, m.aListActive, m.vEveryTime, c.group, 1, mGetString );
- RETURN ret;
- END SetString;
-
- (*\\\*)
- (*/// ------------------ "PROCEDURE ClassDesc.GetString()" ------------------- *)
-
- PROCEDURE ( VAR c : ClassDesc ) GetString( VAR msg : pGetString ):e.APTR;
- VAR str : e.STRPTR;
- BEGIN
- IF y.VAL( LONGINT, c.getHook ) = vGetStringHookString THEN
- m.DoMethod( c.list, m.mListGetEntry, m.vListGetEntryActive, y.ADR( str ) );
- IF (str # NIL) THEN
- ms.Set( c.string, m.aStringContents, str );
- END;
- ELSIF c.getHook # NIL THEN
- RETURN u.CallHookPkt( c.setHook, c.list, c.string );
- END;
- RETURN NIL;
- END GetString;
-
- (*\\\*)
- (*/// ------------------- "PROCEDURE ClassDesc.Dispose()" -------------------- *)
-
- PROCEDURE ( VAR c : ClassDesc ) Dispose*( VAR msg : I.Msg ):e.APTR;
- BEGIN
- IF c.menu # NIL THEN m.DisposeObject( c.menu ) END;
- RETURN c.Dispose^( msg );
- END Dispose;
-
- (*\\\*)
- (*/// --------------------- "PROCEDURE ClassDesc.New()" ---------------------- *)
-
- PROCEDURE ( VAR c : ClassDesc ) New*( VAR msg : I.OpSet ):e.APTR;
- VAR new, remove, up, down : m.Object;
- str : e.LSTRPTR;
- nr, ud : m.Object;
- lgroup : m.Object;
- tags : u.Tags2;
- butGroup : m.Object;
- list : m.Object;
- menu : m.Object;
- newm, removem, upm, downm, helpm : m.Object;
-
- PROCEDURE GetTagString( tl : u.TagListPtr; attr : u.TagID): e.LSTRPTR;
- BEGIN
- RETURN u.GetTagDataP( attr, NIL, tl );
- END GetTagString;
-
- BEGIN
- new := NIL; remove := NIL; up := NIL; down := NIL; nr := NIL; ud := NIL;
- c.setHook := y.VAL( u.HookPtr, u.GetTagData( aSetStringHook, vSetStringHookString, msg.attrList ));
- c.getHook := y.VAL( u.HookPtr, u.GetTagData( aGetStringHook, vGetStringHookString, msg.attrList ));
- list := ms.ListObject( m.aListConstructHook, u.GetTagData( m.aListConstructHook, m.vListConstructHookString, msg.attrList ),
- m.aListDestructHook, u.GetTagData( m.aListDestructHook, m.vListDestructHookString, msg.attrList ),
- u.end );
-
- c.list := ms.ListviewObject( m.aListviewList, list,
- m.aFrame, m.vFrameInputList,
- u.end );
-
- helpm := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aHelpMenuText), NIL,0, aHelpMenuText );
-
- str := GetTagString( msg.attrList, aNewText);
- IF str # NIL THEN
- new := ms.SimpleButton( str^ );
- END;
-
- str := GetTagString( msg.attrList, aRemoveText);
- IF str # NIL THEN
- remove := ms.SimpleButton( str^ );
- END;
-
- str := GetTagString( msg.attrList, aUpText);
- IF str # NIL THEN
- up := ms.SimpleButton( str^ );
- END;
-
- str := GetTagString( msg.attrList, aDownText);
- IF str # NIL THEN
- down := ms.SimpleButton( str^ );
- END;
-
- IF new # NIL THEN
- nr := ms.HGroup( m.aGroupSpacing, 1,
- m.aGroupSameWidth, e.true,
- m.aGroupChild, new,
- m.aGroupChild, remove,
- u.end );
- newm := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aNewMenuText), NIL,0,aNewMenuText);
- removem := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aRemoveMenuText), NIL,0,aRemoveMenuText);
-
-
- END;
- IF up # NIL THEN
- ud := ms.HGroup( m.aGroupSpacing, 1,
- m.aGroupSameWidth, e.true,
- m.aGroupChild, up,
- m.aGroupChild, down,
- u.end );
- upm := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aUpMenuText), NIL,0,aUpMenuText);
- downm := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aDownMenuText), NIL,0,aUpMenuText);
- END;
- IF (nr # NIL) & (ud # NIL) THEN
- butGroup := ms.VGroup( m.aGroupSpacing, 1,
- m.aGroupSameWidth, e.true,
- m.aGroupChild, nr,
- m.aGroupChild, ud,
- u.done );
-
- menu := ms.MenuObject( m.aFamilyChild, newm,
- m.aFamilyChild, removem,
- m.aFamilyChild, upm,
- m.aFamilyChild, downm,
- m.aFamilyChild, m.MakeObject( m.oMenuitem, -1, NIL,0,0),
- m.aFamilyChild, helpm,
- m.aMenuTitle, GetTagString( msg.attrList, m.aFrameTitle ),
- u.done );
- ELSIF (nr # NIL ) THEN
- butGroup := nr;
- menu := ms.MenuObject( m.aFamilyChild, newm,
- m.aFamilyChild, removem,
- m.aFamilyChild, m.MakeObject( m.oMenuitem, -1, NIL,0,0),
- m.aFamilyChild, helpm,
- m.aMenuTitle, GetTagString( msg.attrList, m.aFrameTitle ),
- u.done );
- ELSIF (ud # NIL ) THEN;
- butGroup := ud;
- menu := ms.MenuObject( m.aFamilyChild, upm,
- m.aFamilyChild, downm,
- m.aFamilyChild, m.MakeObject( m.oMenuitem, -1, NIL,0,0),
- m.aFamilyChild, helpm,
- m.aMenuTitle, GetTagString( msg.attrList, m.aFrameTitle ),
- u.done );
- ELSE;
- butGroup := NIL;
- END;
- c.string := ms.StringObject( m.aStringAttachedList, c.list,
- m.aFrame, m.vFrameString,
- u.done );
- IF butGroup # NIL THEN
- lgroup := ms.VGroup( m.aGroupSpacing,1,
- m.aGroupChild, c.list,
- m.aGroupChild, butGroup,
- m.aGroupChild, c.string,
- m.aContextMenu,c.menu,
- u.end );
- ELSE
- lgroup := ms.VGroup( m.aGroupSpacing,1,
- m.aGroupChild, c.list,
- m.aGroupChild, c.string,
- m.aContextMenu, c.menu,
- u.end );
- END;
-
- c.menu := ms.MenustripObject( m.aFamilyChild, menu,
- u.done );
-
- ms.Set( c.list, m.aContextMenu, c.menu );
- tags[0].tag := m.aGroupChild;
- tags[0].data := lgroup;
- tags[1].tag := u.more;
- tags[1].data := msg.attrList;
- msg.attrList := y.ADR(tags);
- c.group := c.New^( msg );
- IF c.group # NIL THEN
- c.CopyClass( c.group );
- ms.Set( c.group, m.aShortHelp, u.GetTagData( m.aShortHelp, NIL, msg.attrList ) );
-
- m.DoMethod( c.string, m.mNotify, m.aStringAcknowledge, m.vEveryTime, c.group, 1, mSetString );
- m.DoMethod( c.list, m.mNotify, m.aListActive, m.vEveryTime, c.group, 1, mGetString );
- IF up # NIL THEN
- m.DoMethod( up, m.mNotify, m.aPressed, e.false, c.group, 1, mUp );
- m.DoMethod( upm, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.group, 1, mUp );
- END;
- IF down # NIL THEN
- m.DoMethod( down, m.mNotify, m.aPressed, e.false, c.group, 1, mDown );
- m.DoMethod( downm, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.group, 1, mDown );
- END;
- IF new # NIL THEN
- m.DoMethod( new, m.mNotify, m.aPressed, e.false, c.list, 3, m.mListInsertSingle, y.ADR( "leer" ), m.vListInsertBottom );
- m.DoMethod( newm, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.list, 3, m.mListInsertSingle, y.ADR( "leer" ), m.vListInsertBottom );
- END;
- IF remove # NIL THEN
- m.DoMethod( remove, m.mNotify, m.aPressed, e.false, c.list, 2, m.mListRemove, m.vListRemoveActive );
- m.DoMethod( removem, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.list, 2, m.mListRemove, m.vListRemoveActive );
- END;
- END;
- RETURN c.group;
- END New;
-
- (*\\\*)
- (*/// ------------------------ "PROCEDURE Dispatch()" ------------------------ *)
-
- PROCEDURE Dispatch * ( cl : I.IClassPtr; obj : I.ObjectPtr; msg : I.MsgPtr ):e.APTR;
- VAR c : Class;
- BEGIN
- IF msg.methodID # I.new THEN
- c := rc.BoopsiToObj( cl, obj )(Class);
- END;
- CASE msg.methodID OF
- | mSetString : RETURN c.SetString( msg^(pSetString) );
- | mGetString : RETURN c.GetString( msg^(pGetString) );
- | mUp : RETURN c.Up( msg^ );
- | mDown : RETURN c.Down( msg^ );
- ELSE
- RETURN sc.Dispatch( cl, obj, msg );
- END;
- END Dispatch;
-
- (*\\\*)
-
- BEGIN
- class := rc.InitPrivFromClass( sc.class, Dispatch, SIZE( ClassDesc ), y.TYPEDESC( ClassDesc ) );
- IF class = NIL THEN HALT(205) END;
- CLOSE
- IF class # NIL THEN IF I.FreeClass( class ) THEN END END;
- END EditListClass.
-
-